﻿<%
'控制英文自动换行并保持英文单词的连续性
function HTMLDecode(fString) 
  if len(fString)>0 then
 fString= Replace(fString,"&nbsp;",chr(32)) 
 HTMLDecode=fString 
  end if
end function

'函数名叫delhtml，用来删除HTML标签的
Function delHtml(strHtml)
  if len(strHtml)>0 then
	Dim objRegExp, strOutput
	Set objRegExp = New Regexp
	
	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "(<[a-zA-Z].*?>)|(<[\/][a-zA-Z].*?>)"
	
	strOutput = objRegExp.Replace(strHtml, "")
	strOutput = Replace(strOutput, "<", "&lt;")
	strOutput = Replace(strOutput, ">", "&gt;") 
	delHtml = strOutput
	
	Set objRegExp = Nothing
  end if
End Function

'去除HTML标签，'所有以<>开头的符号都删除
Function RemoveHTML(strHTML) 
  if len(strHTML)>0 then
	Dim objRegExp, Match, Matches 
	Set objRegExp = New Regexp 
	objRegExp.IgnoreCase = True 
	objRegExp.Global = True 
	objRegExp.Pattern = "<.+?>" 
	Set Matches = objRegExp.Execute(strHTML)
	For Each Match in Matches 
		strHtml=Replace(strHTML,Match.Value,"") 
	Next 
	RemoveHTML=strHTML 
	Set objRegExp = Nothing 
  end if
End Function 

'safeRequest函数
'--- 传入参数 --- 
'ParaName:参数名称-字符型 
'ParaType:参数类型-数字型(1表示程序获取的数字,0表示以程序获取的字符,2表示用户输入的字符) 
'请尽量使用数字来获取，实在不行的情况下，再使用字符。
Function SafeRequest(ParaName,ParaType) 
	Dim ParaValue 
	ParaValue=Request(ParaName) 
	If ParaType=1 then 
		If not isNumeric(ParaValue) then 
			Response.write "参数" & ParaName & "必须为数字型！" 
			Response.end
		end if
	Elseif ParaType=0 then
		ParaValue=replace(ParaValue,"'","") 
		paraValue=Replace(ParaValue," ","")
		paraValue=Replace(ParaValue,"%20","")
		paraValue=Replace(ParaValue,"(","")
		paraValue=Replace(ParaValue,")","")
	Else
		'针对用户输入的内容（如留方、查询等），将半角转为全角。
		ParaValue=replace(ParaValue,"'","＇") 
		ParaValue=Replace(ParaValue," ","　")
		ParaValue=Replace(ParaValue,"(","（")
		ParaValue=Replace(ParaValue,")","）")
	End if 
	SafeRequest=ParaValue 
End function 

Function twScript(N_Content)
	Response.Write("<Script>alert('"&N_Content&"');window.location='"&request.ServerVariables("HTTP_REFERER")&"';</script>")
	Response.End
	twScript=N_Content
End Function

'一般提示,可指定返回地址
Private Function ShowMsg(msg,url)
	Response.Write "<script language=""javascript"">alert('"&msg&"');self.location='"&url&"';</script>"
	Response.End()
End Function

Function Tw(namea)
    Dim nameb
	nameb=Response.Write(namea)
	Tw=nameb
End Function

Function GetSafeStr(str)
	GetSafeStr=Replace(Replace(Replace(Trim(str),"'",""),Chr(34),""),";","")
End Function

'时间格式化开始-------------------------------------------------------------------
Function Dtime(timea,ss)
	Dim timeb
	if month(timea)<10 then
	  yuefen="0"&month(timea)
	else
	  yuefen=month(timea)
	end if
	if day(timea)<10 then
	  ri="0"&day(timea)
	else
	  ri=day(timea)
	end if
	if ss=1 then
	 timeb=year(timea)&"-"&yuefen&"-"&ri
	elseif ss=2 then
	 timeb=year(timea)&"-"&yuefen
	elseif ss=3 then
	 timeb=yuefen&"-"&ri
	elseif ss=4 then
	 timeb=yuefen
	elseif ss=5 then
	 timeb=ri
	end if
	Dtime=timeb
End Function

'时间格式化结束-------------------------------------------------------------------

'英文日期格式化开始-------------------------------------------------------------------
Function Dtime_en(timea,ss)
    Dim timeb
	if month(timea)<10 then
	  yuefen="0"&month(timea)
	else
	  yuefen=month(timea)
	end if
	if day(timea)<10 then
	  ri="0"&day(timea)
	else
	  ri=day(timea)
	end if
	if ss=1 then
	 timeb=year(timea)&"-"&yuefen&"-"&ri
	elseif ss=2 then
	 timeb=yuefen&"-"&ri
	elseif ss=3 then
	 timeb=yuefen
	elseif ss=4 then
	 timeb=ri
	elseif ss=5 then
	  if month(timea)=1 then
	   timeb="January"
	  elseif month(timea)=2 then
	   timeb="February"
	  elseif month(timea)=3 then
	   timeb="March"
	  elseif month(timea)=4 then
	   timeb="April"
	  elseif month(timea)=5 then
	   timeb="May"
	  elseif month(timea)=6 then
	   timeb="June"
	  elseif month(timea)=7 then
	   timeb="July"
	  elseif month(timea)=8 then
	   timeb="August"
	  elseif month(timea)=9 then
	   timeb="September"
	  elseif month(timea)=10 then
	   timeb="October"
	  elseif month(timea)=11 then
	   timeb="November"
	  elseif month(timea)=12 then
	   timeb="December"
	  end if 
	end if
	Dtime_en=timeb
End Function

Function EnMonthName(ByVal vDate)
  monthNames = Split(",Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
  EnMonthName = monthNames(Month(vDate))
End Function

Function entime(timea)
  contects=WeekDayName(DatePart("w",Now))&" , "&day(timea)&" , "&EnMonthName(timea)&" ,&nbsp;"&year(timea)&" : "&hour(now())&":"&minute(now())&" : "&second(now())
  Tw(contects)
End Function
'英文日期格式化结束-------------------------------------------------------------------

'英文截取字数开始--------------------------------------------------------------------
function lenzi1(Tilte_name,size_name)
    dim c
	if Len(Tilte_name)>size_name then
		c=left(Tilte_name,size_name)&"..."
		lenzi1=c
		'lenzi1=replace(replace(replace(replace(c," ",""),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
	else
		lenzi1=Tilte_name
	end if
end function
'英文截取字数结束--------------------------------------------------------------------

'截取字数开始--------------------------------------------------------------------
'**************************************************
'函数名：lenzi
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
function lenzi2(str,strlen)
	if str="" then
		lenzi2=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			lenzi2=left(str,i) & "..."
			exit for
		else
			lenzi2=str
		end if
	next
	lenzi2=replace(replace(replace(replace(lenzi2," ",""),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function
'截取字数结束--------------------------------------------------------------------

Function lenzi(vStr,num)'截断字符串，发布时间：2005-11-03
	Dim v1,n,i,oStr,l,j,sc
	sc=""
	If NOT IsFields(vStr) Then
		lenzi=""
		Exit Function
	End If
	v1=Replace(vStr,"&nbsp;"," ")
	n=0
	oStr=""
	l=num*2'双倍算法
	If v1="" Then'没有数据
		lenzi=""
		Exit Function
	End If
	For i=1 to len(v1)'把汉字识为双字节的
		If Asc(mid(v1,i,1))>0 Then 
			n=n+1
		Else
			n=n+2
		End If
	Next
	If l>=n Then 
		lenzi=IMS_HtmlEncode(v1)
		Exit Function
	End If
	i=1
	j=1
	Do while NOT i>l
		sc=Mid(v1,j,1)
		oStr=oStr+sc
		If Asc(sc)>0 Then
			i=i+1
		Else
			i=i+2
		End If
		j=j+1
	Loop
	if num*2+1<>i then oStr=Left(oStr,Len(oStr)-1)'发现截断了半个单位
	if Len(oStr)<>Len(vStr) then
		if Asc(Right(oStr,1))>0 then'发现结尾是两个单字节数字或字母组成
			oStr=Left(oStr,Len(oStr)-2)
		else
			oStr=Left(oStr,Len(oStr)-1)
		end if
	end if
	lenzi=IMS_HtmlEncode(oStr) & "..."
End Function

Function IMS_HtmlEncode(str)'代替了Server.HTMLEncode()，发布时间：2009-11-16
	Dim tmpStr
	tmpStr=str
	if IsFields(tmpStr) then
		tmpStr=Server.HTMLEncode(tmpStr)
	else
		tmpStr=""
	end if
	IMS_HtmlEncode=tmpStr
End Function

Function IsFields(strText)'判断是否为有效的数据库数据，更新时间：2009-8-1
	If isNull(strText) or Trim(strText)="" or isEmpty(strText) Then
		IsFields=false
	Else
		IsFields=true
	End If
End Function

'企业基本信息开始-------------------------------------------------------------
Set rsContent=Server.CreateObject("ADODB.RecordSet")
strsql="select * from Infor"
rsContent.Open strsql,conn,1,1
Web_Name=rsContent("Web_Name")
Web_Name_en=rsContent("Web_Name_en")
Web_Name_fa=rsContent("Web_Name_fa")
Web_Add=rsContent("Web_Add")
Web_Add_en=rsContent("Web_Add_en")
Web_Add_fa=rsContent("Web_Add_fa")
Web_Phone=rsContent("Web_Phone")
Web_Fax=rsContent("Web_Fax")
Web_LeaguePhone=rsContent("Web_LeaguePhone")
Web_Serverphone=rsContent("Web_Serverphone")
Web_http=rsContent("Web_http")
Web_Mail=rsContent("Web_Mail")
Web_Mobilephone=rsContent("Web_Mobilephone")
Web_Lxr=rsContent("Web_Lxr")
Web_Lxr_en=rsContent("Web_Lxr_en")
Web_Zipcode=rsContent("Web_Zipcode")
Web_Wenti=rsContent("Web_Wenti")
Web_Daan=rsContent("Web_Daan")
Web_description=rsContent("Web_description")
Web_description_en=rsContent("Web_description_en")
Web_description_fa=rsContent("Web_description_fa")
Web_keywords=rsContent("Web_keywords")
Web_keywords_en=rsContent("Web_keywords_en")
Web_keywords_fa=rsContent("Web_keywords_fa")
Web_title=rsContent("Web_title")
Web_title_en=rsContent("Web_title_en")
Web_title_fa=rsContent("Web_title_fa")
Web_QQ=rsContent("Web_QQ")
Web_MSN=rsContent("Web_MSN")
Web_Skype=rsContent("Web_Skype")
logo=rsContent("logo")
weixin=rsContent("weixin")
call rsclose(rsContent)
'企业基本信息结束------------------------------------------------------

'替换空格
Function ReplaceSpaces(strHTML) 
  if len(strHTML)>0 then
	Dim objRegExp, Match, Matches 
	Set objRegExp = New Regexp 
	objRegExp.IgnoreCase = True 
	objRegExp.Global = True 
	objRegExp.Pattern = "(&nbsp;)+?(&nbsp;)"
	Set Matches = objRegExp.Execute(strHTML)
	For Each Match in Matches 
		strHtml=Replace(strHTML,Match.Value,"") 
	Next 
	ReplaceSpaces=strHTML 
	Set objRegExp = Nothing 
  end if
End Function 

'检查字符串NUM是否为数字
Function CheckInt(num)
	Dim re1
    CheckInt=False
	Set re1 = New RegExp
    re1.IgnoreCase = False
    re1.Global = True
    re1.Pattern = "^[0-9]+?$"
    CheckInt = re1.Test(num)
End Function

'检查输入字符串是否全为0
Private Function IsZero(CC)
	Dim re2
	IsZero = False
	Set re2 = New RegExp
	re2.IgnoreCase = False
	re2.Global = True
	re2.Pattern = "^0+?$"
	IsZero = re2.Test(CC)
End Function

'格式化价格
Private Function FormatPrice(p)
	If Left(p,1)="." Then p="0"&p
	FormatPrice=p
End Function

'货币格式转化
Function strcurrency(str)
    str=mid(cstr(formatcurrency(str,2)),2)
	strcurrency=str
end Function 
%>